(FILECREATED "30-Sep-78 10:39:28" <LENAT>UE2.;6 7193   

     changes to:  UA-GETUNIT UA-GETSLOT

     previous date: "29-Sep-78 20:31:24" <LENAT>UE2.;3)


(PRETTYCOMPRINT UE2COMS)

(RPAQQ UE2COMS [(FNS * UE2FNS)
		(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
										      (NLAML])

(RPAQQ UE2FNS (UE-SLOTLIST UE-TOP UA-GETUNIT UA-GETSLOT))
(DEFINEQ

(UE-SLOTLIST
  [LAMBDA (SLIST PRINTUNIT)

          (* UE-SLOTLIST writes the values of all inherited slots in the current unit)


    (if PRINTUNIT=NIL
	then PRINTUNIT←UECURUNIT)
    [if UEBREVITY
	then [for SLOT in SLIST unless (AND (CLASS? (DATATYPE? SLOT PRINTUNIT)
						    (QUOTE HIDESLOT))
					    }UEHACKER)
		do (PROG (VAL DEF)
		         (PRIN1 SLOT)
		         (PRIN1 ": ")
		         (TAB 17 1)
		         (PRINTSLOT SLOT PRINTUNIT)
		         (if (AND (SETQ DEF (GETFIELD (QUOTE DEFAULT)
						      SLOT PRINTUNIT))
				  (if VAL←(GETVALUE SLOT PRINTUNIT)
				      then }(CHECKRESTRICTION SLOT PRINTUNIT DEF VAL))
				  }(CLASS? (DATATYPE? SLOT PRINTUNIT)
					   'HPRINT)
				  }(EQUAL VAL DEF))
			     then (PRIN1 " Default: ")
				  (TAB 17 1)
				  (PRINTSLOT SLOT PRINTUNIT DEF]
      else (for (SLOT DEFAULT) in SLIST unless (AND (CLASS? (DATATYPE? SLOT PRINTUNIT)
							    (QUOTE HIDESLOT))
						    }UEHACKER)
	      do (PROGN (TAB 1 0)
			(PRIN1 SLOT)
			(PRIN1 ":  ")
			(TAB 17 0)
			(PRIN1 (ROLE? SLOT PRINTUNIT))
			(TAB 23)
			(if (TOPLEVELSLOT? SLOT PRINTUNIT)
			    then (PRIN1 "*Top*")
			  else (PRIN1 "from ")
			       (PRIN1 (TOPLEVELUNIT? SLOT PRINTUNIT)))
			(TAB 38)
			(PRIN1 "<")
			(PRIN1 (GETFIELD 'DATATYPE SLOT PRINTUNIT))
			(PRIN1 ">")
			(TAB 50)
			(PRINTSLOT SLOT PRINTUNIT)
			(if (AND (SETQ DEFAULT (GETFIELD (QUOTE DEFAULT)
							 SLOT PRINTUNIT))
				 }(TERMINALVALUE? SLOT PRINTUNIT))
			    then (TAB 39)
				 (PRIN1 "Default:")
				 (TAB 50)
				 (PRINTSLOT SLOT PRINTUNIT DEFAULT))
			(for FIELD in (LISTFIELDS SLOT PRINTUNIT T) do (TAB 5)
								       (PRIN1 FIELD)
								       (TAB 17)
								       (PRINT (GETFIELD FIELD SLOT PRINTUNIT]
    (TERPRI])

(UE-TOP
  [LAMBDA (RECURSEFLG)

          (* UE-TOP is the top-level editor function. It greets the user and gets a top- level command)


    (PROG (UECOMMAND REPLY)
          (if RECURSEFLG
	      then 

          (* Count Recursions.)


		   UERECDEPTH←UERECDEPTH+1
		   (WRITE "
(UE level " UERECDEPTH ")")
	    else UERECDEPTH←0)
          (if (AND (ZEROP UERECDEPTH)
		   UEBEENCALLED=NIL)
	      then 

          (* Here on the first call to UE-TOP.)


		   UA.NAME←1
		   UA.RELS←NIL
		   (WRITE 

"Welcome to the MOLGEN Unit Editor.  Type ? anytime for assistance.
The symbol : indicates that the editor is waiting for your input.
Two characters are enough for command recognition.  You may type ahead
responses for a command.")
		   (TERPRI)
		   (INTERRUPTCHAR 11 '(UE-TOP T)
				  T)

          (* Pick a network.)


		   (UE-NETWORK) 

          (* Greet to initialize Sysin)


		   UEBEENCALLED←T)
          (while T do (UECOMMAND←(INTTY ":" UECOMSTRINGS (CONCAT "Legal commands are:
" UEFULLSTRINGS (if UERECDEPTH=0
		    then " "
		  else (CONCAT "
(You are at recursion level " UERECDEPTH ")"))
								 "
(You are editing Knowledge Base " UA.FILENAME ")")))
		      (NLSETQ (SELECTQ UECOMMAND
				       ((DO OK)
					 (if UERECDEPTH=0
					     then 

          (* Save Network and exit)


						  (if UENETWORK
						      then (if 'Y =(INTTY (CONCAT "Save " (UA-LOCALFILENAME UENETWORK)
										  "? ")
									  '("Y" "N")
									  
						       "Type Y to save the network on file.  
Type N to exit without saving.")
							       then (WRITE "Saving " (UA-LOCALFILENAME UENETWORK))
								    (CLOSENETWORK)
								    UENETWORK←NIL
								    (WRITE "Bye!  (Returning you to TENEX)")
								    (LOGOUT)
								    (RETURN 'Hello-Again)))
					   else (WRITE "(Leaving UE level " UERECDEPTH ")")
						UERECDEPTH←UERECDEPTH-1
						(CLEARBUF))
					 (RETURN 'BYE))
				       (CO (UE-UNITCOPY))
				       (CR (UE-CREATE))
				       (DE (UE-DELETE))
				       (SPL (UE-SPLITUNIT))
				       (ED (UE-MODIFY))
				       (SE (UE-SETPROFILE))
				       (NE (UE-NETWORK))
				       (DI (UE-DISPLAY))
				       (PR (UE-UNITPRINT))
				       (SU (UE-SUMMARYFILE))
				       (WH (UE-WHATSNEW))
				       (TR (UT-TOP))
				       (RE (UE-RENAME))
				       (SA (CLOSENETWORK T)
					   (WRITE "(" UENETWORK " saved.)"))
				       (MS (UE-MSG))
				       (REC (UE-RECORD))
				       (?M REPLY←(INTTY "Unit: " NIL 
							"Enter the name of the unit for which you want a message list.")
					   (if }(UNIT? REPLY)
					       then REPLY←(UE-USPELLFIX REPLY))
					   (if REPLY
					       then REPLY←(for SLOT in (LISTSLOTS REPLY) when 'LISP =(GETFIELD 'DATATYPE SLOT 
													       REPLY)
							     collect SLOT)
						    (if REPLY
							then (WRITE "Msgs: " REPLY)
						      else (WRITE "No messages recognized by this unit."))
					     else (WRITE "Unit not found")))
				       (SPE (UE-SPEC))
				       (MA (UE-MATCH))
				       (GR (UE-GROUP))
				       (WRITE "Unrecognizable command, please try again (or ?)")))
		      (CLEARBUF)))
    'BYE])

(UA-GETUNIT
  [LAMBDA (UNIT)
    (CLISP: FAST)

          (* UA-GETUNIT accepts the name of a unit and looks for it in the unit relation hash table.
	  If it finds the unit, it resets the global variables. If it finds the unit, it returns the NAME, otherwise it 
	  returns NIL.)


    (if UNIT=UA.NAME
	then UNIT
      else (PROG (LOCALREF)

          (* Don't bother hashing if EQ to last unit referenced.)


	         (RETURN (AND (SETQ LOCALREF (GETHASH UNIT UA.RELS))
			      (PROGN 

          (* Reset global pointers for Most-recent-reference)


				     UA.NAME←UNIT
				     UA.REF←LOCALREF
				     UA.UNIT←UA.REF:REL.UNIT
				     UA.SLOTNAME←NIL
				     UA.SLOTREF←NIL
				     UA.NAME])

(UA-GETSLOT
  [LAMBDA (SLOT)
    (CLISP: FAST)

          (* UA-GETSLOT searches the current unit in UA.UNIT for a slot named SLOT. If it finds it, it resets the global
	  variables UA.SLOTREF and UA.SLOTNAME to that slot and returns the name of the slot. Otherwise it returns NIL.
	  UA-GETSLOT first checks that the slot information for this unit is core resident. If it is not, UA-GETSLOT 
	  call UA-LOADUNIT to bring the unit in from the UNITS file.)


    (if SLOT=UA.SLOTNAME
	then SLOT
      elseif UA.UNIT
	then (UA.REF:REL.TIME←(CLOCK 0))
	     (if UA.SLOTREF←(for X in UA.UNIT thereis SLOT=X:SLOT.NAME)
		 then UA.SLOTNAME←SLOT
	       else NIL)
      else 

          (* Load the unit if it is not resident.)


	   (UA-LOADUNIT UA.NAME)
	   (UA.REF:REL.TIME←(CLOCK 0))
	   (if UA.SLOTREF←(for X in UA.UNIT thereis SLOT=X:SLOT.NAME)
	       then UA.SLOTNAME←SLOT
	     else NIL])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (391 7061 (UE-SLOTLIST 403 . 2186) (UE-TOP 2190 . 5405) (UA-GETUNIT 5409 . 6138) (UA-GETSLOT 6142 . 7058)))))
STOP